Calculating the Number of Infections

This notebook is based on covid_19.Rmd. I created the present notebook because there was already too much information in covid_19.Rmd.

Methodology

• We know the number of people dead.
• We have estimates of how many people die from the disease.
• Assumes that the mean number of days from infection to death is 14 (see covid_infection_estimates2.Rmd for estimates using 28 days as the assumption)

1. Import files and packages

library(tidyr)
library(dplyr)

Attaching package: ‘dplyr’

The following objects are masked from ‘package:stats’:

    filter, lag

The following objects are masked from ‘package:base’:

    intersect, setdiff, setequal, union

library(stringr)
library(readr)
library(lubridate)

Attaching package: ‘lubridate’

The following object is masked from ‘package:base’:

    date

deaths <- read_csv('covid_19_deaths.csv')

Parsed with column specification:
cols(
  Date = col_date(format = ""),
  `UK Deaths` = col_double(),
  `Global Deaths` = col_double()
)

2. inspect and clean the data

deaths <- deaths %>% mutate(infection_date=Date-days(14))
deaths <- deaths %>% rename(death_date=Date, deaths=`UK Deaths`)
uk_data <- deaths %>% select(-`Global Deaths`)
head(uk_data)

3. Add estimates of infections (three columns, showing a low, middle and a high estimate)

#add columns for various estimated death rates (0.1%, 0.5%, 1%, 2%, 3%)

uk_data <- uk_data %>% mutate(estimated_uk_cases_tenth=(deaths*1000))
uk_data <- uk_data %>% mutate(estimated_uk_cases_one=(deaths*100))
uk_data <- uk_data %>% mutate(estimated_uk_cases_two=(deaths*50))
uk_data

NA

4. clean the data again (reorder the columns)

# order should be two, one, tenth (as this shows the min-max range better)

5. create a new table that starts at 22nd March (since uk_data infection_date went up to 21st March at the time I created this code)

# using only estimates of 1% death rate and growth rate of doubling every 3-4 days (which means quadrupling in a week)

predictor <- function(previous_value) {
    predicted_value <- previous_value * 1.25
    return(predicted_value)
    }

# create predictions for each date
twentyTwoMarch <- 1.25 * 360500
twentyThreeMarch <- predictor(twentyTwoMarch)
twentyFourMarch <- predictor(twentyThreeMarch)
twentyFiveMarch <- predictor(twentyFourMarch)
twentySixMarch <- predictor(twentyFiveMarch)
twentySevenMarch <- predictor(twentySixMarch)
twentyEightMarch <- predictor(twentySevenMarch)
twentyNineMarch <- predictor(twentyEightMarch)
thirtyMarch <- predictor(twentyNineMarch)
thirtyOneMarch <- predictor(thirtyMarch)
oneApril <- predictor(thirtyOneMarch)
twoApril <- predictor(oneApril)
threeApril <- predictor(twoApril)
fourApril <- predictor(threeApril)
fiveApril <- predictor(fourApril)
sixApril <- predictor(fiveApril)
sevenApril <- predictor(sixApril)
eightApril <- predictor(sevenApril)
nineApril <- predictor(eightApril)
tenApril <- predictor(nineApril)
elevenApril <- predictor(tenApril)
twelveApril <- predictor(elevenApril)

thirteenApril <- predictor(twelveApril)
fourteenApril <- predictor(thirteenApril)
fifteenApril <- predictor(fourteenApril)
sixteenApril <- predictor(fifteenApril)
seventeenApril <- predictor(sixteenApril)
eighteenApril <- predictor(seventeenApril)
nineteenApril <- predictor(eighteenApril)
twentyApril <- predictor(nineteenApril)
twentyoneApril <- predictor(twentyApril)
twentytwoApril <- predictor(twentyoneApril)
twentythreeApril <- predictor(twentytwoApril)
twentyfourApril <- predictor(twentythreeApril)
twentyfiveApril <- predictor(twentyfourApril)


# create vectors to populate the columns
date <- as.Date(c("2020-03-22", "2020-03-23", "2020-03-24", "2020-03-25", '2020-03-26','2020-03-27', '2020-03-28', '2020-03-29', '2020-03-30', '2020-03-31', "2020-04-01", "2020-04-02", "2020-04-03", "2020-04-04", "2020-04-05", "2020-04-06", "2020-04-07", "2020-04-08", "2020-04-09", "2020-04-10", "2020-04-11", "2020-04-12", "2020-04-13", "2020-04-14", "2020-04-15", "2020-04-16", "2020-04-17", "2020-04-18", "2020-04-19", "2020-04-20", "2020-04-21", "2020-04-22", "2020-04-23", "2020-04-24", "2020-04-25"))
estimated_infections_no_action <- c(twentyTwoMarch, twentyThreeMarch, twentyFourMarch, twentyFiveMarch,twentySixMarch, twentySevenMarch, twentyEightMarch, twentyNineMarch, thirtyMarch, thirtyOneMarch, oneApril, twoApril, threeApril, fourApril, fiveApril, sixApril, sevenApril, eightApril, nineApril, tenApril, elevenApril, twelveApril, thirteenApril, fourteenApril, fifteenApril, sixteenApril, seventeenApril, eighteenApril, nineteenApril, twentyApril, twentyoneApril, twentytwoApril, twentythreeApril, twentyfourApril, twentyfiveApril)

# create the data frame
predicted_infections <- data.frame(date, estimated_infections_no_action)

# tidy the estimated_infections column
#predicted_infections <- predicted_infections %>% mutate(estimated_infections=format(estimated_infections, big.mark = ","))

# inspect the data frame
predicted_infections

6. Create another dataframe to estimate the impact of social distancing on the estimate

# create a function that uses a growth rate of 1.125 - half of the 25%. This is the estimate for the not-yet-lockdown that existed up to 23rd March. So, the estimate assumes that the social distancing measures reduced the infection rate by a half.
half_predictor <- function(previous_value) {
    predicted_value <- previous_value * 1.125
    return(predicted_value)
}

# create a function that uses a growth rate of 1.0625 - quarter of the 25%. This is the estimated impact of the lockdown implemented by the UK government on 23rd March (but since the lockdown was announced in the evening, and it would take a full day for its effects to be felt in statistics, I will assume that its effects began on 25th March).
lockdown_predictor <- function(previous_value) {
  predicted_value <- previous_value * 1.0625
  return(predicted_value)
}

# create predictions for each date
twentyTwoMarch <- 1.125 * 360500
twentyThreeMarch <- half_predictor(twentyTwoMarch)
twentyFourMarch <- half_predictor(twentyThreeMarch)
twentyFiveMarch <- lockdown_predictor(twentyFourMarch)
twentySixMarch <- lockdown_predictor(twentyFiveMarch)
twentySevenMarch <- lockdown_predictor(twentySixMarch)
twentyEightMarch <- lockdown_predictor(twentySevenMarch)
twentyNineMarch <- lockdown_predictor(twentyEightMarch)
thirtyMarch <- lockdown_predictor(twentyNineMarch)
thirtyOneMarch <- lockdown_predictor(thirtyMarch)
oneApril <- lockdown_predictor(thirtyOneMarch)
twoApril <- lockdown_predictor(oneApril)
threeApril <- lockdown_predictor(twoApril)
fourApril <- lockdown_predictor(threeApril)
fiveApril <- lockdown_predictor(fourApril)
sixApril <- lockdown_predictor(fiveApril)
sevenApril <- lockdown_predictor(sixApril)
eightApril <- lockdown_predictor(sevenApril)
nineApril <- lockdown_predictor(eightApril)
tenApril <- lockdown_predictor(nineApril)
elevenApril <- lockdown_predictor(tenApril)
twelveApril <- lockdown_predictor(elevenApril)

thirteen_April <- lockdown_predictor(twelveApril)
fourteen_April <- lockdown_predictor(thirteen_April)
fifteen_April <- lockdown_predictor(fourteen_April)
sixteen_April <- lockdown_predictor(fifteen_April)
seventeen_April <- lockdown_predictor(sixteen_April)
eighteen_April <- lockdown_predictor(seventeen_April)
nineteen_April <- lockdown_predictor(eighteen_April)
twenty_April <- lockdown_predictor(nineteen_April)
twentyone_April <- lockdown_predictor(twenty_April)
twentytwo_April <- lockdown_predictor(twentyone_April)
twentythree_April <- lockdown_predictor(twentytwo_April)
twentyfour_April <- lockdown_predictor(twentythree_April)
twentyfive_April <- lockdown_predictor(twentyfour_April)

# create vectors to populate the columns
date <- as.Date(c("2020-03-22", "2020-03-23", "2020-03-24", "2020-03-25", '2020-03-26','2020-03-27', '2020-03-28', '2020-03-29', '2020-03-30', '2020-03-31', "2020-04-01", "2020-04-02", "2020-04-03", "2020-04-04", "2020-04-05", "2020-04-06", "2020-04-07", "2020-04-08", "2020-04-09", "2020-04-10", "2020-04-11", "2020-04-12", "2020-04-13", "2020-04-14", "2020-04-15", "2020-04-16", "2020-04-17", "2020-04-18", "2020-04-19", "2020-04-20", "2020-04-21", "2020-04-22", "2020-04-23", "2020-04-24", "2020-04-25"))
estimated_infections_lockdown <- c(twentyTwoMarch, twentyThreeMarch, twentyFourMarch, twentyFiveMarch,twentySixMarch, twentySevenMarch, twentyEightMarch, twentyNineMarch, thirtyMarch, thirtyOneMarch, oneApril, twoApril, threeApril, fourApril, fiveApril, sixApril, sevenApril, eightApril, nineApril, tenApril, elevenApril, twelveApril, thirteen_April, fourteen_April, fifteen_April, sixteen_April, seventeen_April, eighteen_April, nineteen_April, twenty_April, twentyone_April, twentytwo_April, twentythree_April, twentyfour_April, twentyfive_April)

# create the data frame
lockdown_infection_rates <- data.frame(date, estimated_infections_lockdown)

# tidy the estimated_infections column
#lockdown_infection_rates <- lockdown_infection_rates %>% mutate(estimated_infections_lockdown=format(estimated_infections_lockdown, scientific = FALSE))

# inspect the data frame
lockdown_infection_rates

NA

## 7. Merge the two prediction dataframes

compared_infections <- predicted_infections %>% bind_cols(estimated_infections_lockdown=lockdown_infection_rates$estimated_infections_lockdown)

compared_infections

NA

8. Tidy the data

#compared_infections <- compared_infections %>% mutate(estimated_infections=format(estimated_infections, big.mark = ","))
#compared_infections <- compared_infections %>% mutate(estimated_infections_lockdown=as.numeric(estimated_infections_lockdown))
#compared_infections <- compared_infections %>% mutate(estimated_infections_lockdown=format(estimated_infections_lockdown, big.mark = ","))
compared_infections

The above table shows a huge possible effect of lockdown, but still the number of infections is in seven figures. However, this does not indicate how many people might be infected at any given time. Rather, it estimates how many people might have been infected in total, and so includes people who no longer have the disease (that is, people who have recovered or died).

9. Predicted deaths based on these estimates

Working backwards from these estimates, compare the predicted deaths.

# first, put the columns back to numeric format
#compared_infections_and_deaths <- compared_infections %>% mutate(estimated_infections=as.numeric(estimated_infections))

compared_infections_and_deaths <- compared_infections %>% mutate(estimated_deaths_no_action=0.01*estimated_infections_no_action)
compared_infections_and_deaths <- compared_infections_and_deaths %>% mutate(estimated_deaths_lockdown=0.01*estimated_infections_lockdown)
compared_infections_and_deaths

Note that the estimates_deaths and estimated_deaths_lockdown columns are not estimates for deaths on or up to the date in the relevant row. It is anticipated that deaths would occur some days or weeks after the date given in the table. For example, if the row for 2020-04-01 shows estimated_deaths_lockdown of 8336.703, that doesn’t mean 8336.703 people would have died by 2020-04-01. Rather, that figure would occur around two weeks after 2020-04-01 (so, approximately 2020-04-15). So, this suggests an additional column might be useful (date of predicted deaths) ymd(‘2019-12-01’) %m+% period(“1 month”)

compared_infections_and_deaths_dates <- compared_infections_and_deaths %>% mutate(death_date_14_days=as.Date(date + days(14)))
compared_infections_and_deaths_dates <- compared_infections_and_deaths_dates %>% mutate(death_date_7_days=as.Date(date + days(7)))

# add a column to review the results on a daily basis.
assess <- c("NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA")
compared_infections_and_deaths_dates <- compared_infections_and_deaths_dates %>% mutate(fourteen_day_assessment = assess)

compared_infections_and_deaths_dates <- compared_infections_and_deaths_dates %>% mutate(fourteen_day_assessment=replace(fourteen_day_assessment, death_date_14_days==c("2020-04-05", "2020-04-06", "2020-04-07", "2020-04-08", "2020-04-09", "2020-04-10", "2020-04-11", "2020-04-12", "2020-04-13", "2020-04-14", "2020-04-15", "2020-04-16", "2020-04-17", "2020-04-18", "2020-04-19", "2020-04-20", "2020-04-21", "2020-04-22"), c("As of 2020-04-05, the actual death toll was 4313", "As of 2020-04-06, the actual death toll was 4934", "As of 2020-04-07, the actual death toll was 5373", "As of 2020-04-08, the actual death toll was 6159", "As of 2020-04-09, the actual death toll was 7097", "As of 2020-04-10, the actual death toll was 7978","As of 2020-04-11, the actual death toll was 8958","As of 2020-04-12, the actual death toll was 9875", "As of 2020-04-13, the actual death toll was 10612", "As of 2020-04-14, the actual death toll was 11329", "As of 2020-04-15, the actual death toll was 12107", "As of 2020-04-16, the actual death toll was 12868", "As of 2020-04-17, the actual death toll was 13729", "As of 2020-04-18, the actual death toll was 14576", "As of 2020-04-19, the actual death toll was 15464", "As of 2020-04-20, the actual death toll was 16060", "As of 2020-04-22, the actual death toll was 16509", "As of 2020-04-21, the actual death toll was 17337")))

longer object length is not a multiple of shorter object length

#reorder the columns
new_order <- c("date", "estimated_infections_no_action", "estimated_infections_lockdown", "estimated_deaths_no_action",  "estimated_deaths_lockdown", "death_date_14_days", "fourteen_day_assessment", "death_date_7_days")

compared_infections_and_deaths_dates <- compared_infections_and_deaths_dates[, new_order]

#names <- colnames(compared_infections_and_deaths_dates)
#names
compared_infections_and_deaths_dates

In what ways could these estimates and predictions go wrong? Or, what parts of the data could be inaccurate? * estimate of 1% death rate * estimate of time taken for lockdown to have an effect (I’ve said 14-21 days). Note that death_date_7_days shows the date if it takes 21 days to have an impact. * estimate of daily growth rates for minimal social distancing (1.125) and lockdown (1.0625)

• update 6th April 2020 - it looks like my predictions may be a day or two out of synch with the stats. It’s hard to tell, as the number for lockdown and no action are fairly similar at this point. This means that it can be difficult to make an assessment: if the actual death toll is lower than the estimated_deaths_no_action column, is that due to the lockdown or the fact that it is a day or two behind? However, by around 10th April there should be a clearer picture.

• update 10th April 2020 - it now looks like my predictions might be 3 or 4 days out of synch with the stats. Look at the death_date_14_days column, then add 4 days. Then look at the estimated_deaths_lockdown column. This seems to be closer to the actual death toll.
• update 11th April 2020: hospital deaths versus total deaths. My figures are for total deaths, but the UK provides figures for hospital deaths. One estimate I saw was that there were over 8000 deaths in hospital, plus an additional 1000 in care homes that were not included in the UK figures. I’m not sure whether or not the WHO figures cover only hospital deaths, but if they do then it would have an impact on my predictions.
• update 12th April 2020 - it now looks like my predictions are 5-6 days out of synch with the stats. So, look at the death_date_14_days column, then add 5 or 6 days.
• update 13th April 2020 - the latest figures from the Office for National Statistics suggest that - in England and Wales, at least - deaths outside hospitals account for around 10% of all Covid-19-related deaths. Whilst I do not have the non-hospital figures for Scotland or Northern Ireland, I have no reason to believe they would be significantly different from England and Wales. So, I will assume that 10% of all Covid-19-related deaths in the UK happen outside of hospitals. This has an impact on how one reads the figures in my project. The figures I use in this project are from the WHO, which counts hospital deaths only. Therefore, for any given date, the number of deaths in my datasets should be considered to be only 90% of the true total. For instance, where my datasets state that the death toll on 11th April was 8958, we can estimate that the true death toll was actually around 10,000.

• update 17th April - the figures are 6-7 days out.

library(ggplot2)
library(scales)
infectionsComparisonLine <- ggplot(compared_infections_and_deaths_dates, aes(x=date)) + geom_line(aes(y=estimated_infections_no_action), col = "steelblue") + geom_line(aes(y=estimated_infections_lockdown), col="darkred") + scale_y_continuous(labels=label_comma()) + geom_text(aes(x=as.Date("2020-04-13"), y = 50000000, label="No action")) + geom_text(x=as.Date("2020-04-13"), y = 5000000, label="Lockdown") + labs(title="Predicted infections (lockdown versus no action)", x='Date', y='Predicted Infections') + theme_classic()
infectionsComparisonLine

NA

deathsComparisonLine <- ggplot(compared_infections_and_deaths_dates, aes(x=death_date_7_days)) + geom_line(aes(y=estimated_deaths_no_action), col = "steelblue") + geom_line(aes(y=estimated_deaths_lockdown), col="darkred") + scale_y_continuous(labels=label_comma()) + geom_text(aes(x=as.Date("2020-04-21"), y = 500000, label="No action")) + geom_text(x=as.Date("2020-04-21"), y = 50000, label="Lockdown") + labs(title="Predicted Deaths (lockdown versus no action)", subtitle="estimates that it takes 3 weeks for measures to impact deaths", x='Date', y='Predicted Deaths') + theme_classic()
deathsComparisonLine

deathsComparisonLine <- ggplot(compared_infections_and_deaths_dates, aes(x=death_date_14_days)) + geom_line(aes(y=estimated_deaths_no_action), col = "steelblue") + geom_line(aes(y=estimated_deaths_lockdown), col="darkred") + scale_y_continuous(labels=label_comma()) + geom_text(aes(x=as.Date("2020-04-28"), y = 500000, label="No action")) + geom_text(x=as.Date("2020-04-28"), y = 50000, label="Lockdown") + labs(title="Predicted Deaths (lockdown versus no action)", subtitle="estimates that it takes 2 weeks for measures to impact deaths", x='Date', y='Predicted Deaths') + theme_classic()
deathsComparisonLine

library(plotly)
casesDeaths <- ggplot(compared_infections_and_deaths_dates, aes(x=estimated_infections_lockdown, y=estimated_deaths_lockdown)) + geom_point()
casesDeaths

interactive <- ggplotly(casesDeaths)

# fig <- interactive %>%
#   plot_ly(
#     x = ~x,
#     y = ~y,
#     frame = ~f,
#     type = 'scatter',
#     mode = 'markers',
#     showlegend = F
#   )
fig <- compared_infections_and_deaths_dates %>% plot_ly(x=~estimated_infections_lockdown, y=~estimated_deaths_lockdown, frame = ~date, type = 'scatter', mode='markers')


# fig <- fig %>% layout(
#     xaxis = list(
#       type = "log"
#     )
#   )
 

fig2 <- fig %>% animation_slider(currentvalue=list(prefix = "Date", font = list(color='red')))
fig2

NA